home *** CD-ROM | disk | FTP | other *** search
- /*************************************/
- /* */
- /* *** HAPPy Pascal compiler *** */
- /* identifier routine */
- /* */
- /* Copyright (c) H.Asano 1992 */
- /*************************************/
-
- #define EXTERN extern
-
- #include <string.h>
- #include "pascomp.h"
-
- extern void pcerr(int,char*) ; /* エラーメッセージ出力処理 */
- extern int crelabel(void) ;
- extern void enterstdpf(void) ; /* 標準手続き・関数名の登録処理*/
- extern void term(void) ; /* 終了処理 */
- extern void *Malloc(int) ; /* メモリ確保処理 */
-
-
- /**************************************/
- /* mkctp() : ctp型のエリアを確保する */
- /**************************************/
- ctp *mkctp(char *fname,enum idclass fklass,stp *fidtype,ctp *fnext)
- {
- ctp *lcp ;
-
- lcp = (ctp*)Malloc(sizeof(ctp)) ; /* ctp型エリアを確保 */
-
- strcpy(lcp->name,fname) ; /* 名前の設定 */
- lcp->idtype = fidtype ; /* 型の設定 */
- lcp->next = fnext ; /* 次へのリンクの設定 */
- lcp->klass = fklass ; /* 名前の種類の設定 */
-
- return(lcp) ;
- }
-
- /**************************************/
- /* enterid() : */
- /* identifier を tree に登録 */
- /**************************************/
-
- void enterid(ctp *fcp)
- {
- ctp *lcp;
- ctp *lcp1;
- aplist *lap ;
- boolean lleft ; /* 右か左に登録するかのフラグ lleft=true : 左 */
- int cmpresult; /* strcmp の 結果 */
-
- lap = display[top].aname ; /* 定義より先に参照されたか */
- while(lap) { /* 調べる */
- if(!strcmp(lap->name->name,fcp->name)) {
- pcerr(100,fcp->name) ; /* 宣言よりも先に参照された */
- return;
- }
- lap = lap->next ;
- }
-
- lcp = display[top].fname;
- if(!lcp) {
- display[top].fname = fcp ; /* その水準での最初の登録 */
- fcp->llink = nil;
- fcp->rlink = nil;
- return;
- }
-
- do {
- lcp1 = lcp ;
- if(!(cmpresult=strcmp(lcp->name, fcp->name))){/* 既に名前が存在する時 */
- pcerr(101,lcp->name); /* 名前の二重定義エラー */
- return ; /* 登録せずに打ち切り */
- }
- else
- if(cmpresult < 0) { /* 登録する名前が大きい時 */
- lcp = lcp->rlink; /* 右側を探索 */
- lleft = false;
- }
- else { /* 登録する名前が小さい時 */
- lcp = lcp->llink; /* 左側を探索 */
- lleft = true ;
- }
- } while (lcp) ;
-
- if(lleft) lcp1->llink = fcp ; /* 左側への登録 */
- else lcp1->rlink = fcp; /* 右側への登録 */
-
- fcp->llink = nil;
- fcp->rlink = nil;
- }
-
- /*****************************************/
- /* searchsection() : */
- /* identifier を ある水準だけから探す */
- /* ・ レコードの名前を処理する場合 */
- /* ・ 前方参照された手続き・関数名 */
- /*****************************************/
- ctp *searchsection(ctp *fcp)
- {
- int cmpresult; /* strcmp の 結果 */
- while(fcp) {
- if(!(cmpresult=strcmp(id,fcp->name))) /* 名前が一致した場合 */
- return(fcp) ;
- fcp = (cmpresult > 0) ? fcp->rlink : fcp->llink ;
- }
- return(nil) ; /* 見つからない場合 */
- }
-
- /**************************************/
- /* searchid() : */
- /* identifier を 探す */
- /**************************************/
- ctp *searchid(Set fidcls)
- {
- ctp *lcp ;
- boolean error103 = false ;
- int cmpresult; /* strcmp の 結果 */
-
- for(disx=top ; disx>=0 ; disx--) { /* disxは共通変数 */
- /* 名前が見つかった水準を示す*/
- lcp = display[disx].fname ;
- while(lcp) {
- if(!(cmpresult=strcmp(id, lcp->name)))/* 名前が一致した */
- if(inset(fidcls,lcp->klass)) /* 属性が一致した */
- return(lcp) ; /* その時のlcpを返す */
- else { /* 名前は一致したが属性が違う */
- pcerr(103,id) ; /* 名前の種類が適当でない */
- error103 = true ;
- break ; /* while loop を抜ける */
- }
- else
- lcp = (cmpresult > 0) ? lcp->rlink : lcp->llink ;
- }
- }
-
- /* 見つからなかった時はlcp=nilでここに来る */
-
- if(! error103) pcerr(104,id) ; /* 103エラーが出ていなければ
- 名前が宣言されていないエラーを出す */
-
- /* ポインタ型前方参照ではない時
- 未定義用のエリアを返却する */
- if(inset(fidcls,types)) return(utypptr) ; /* type 型の時 */
- if(inset(fidcls,proc )) return(uprcptr) ; /* proc 型の時 */
- if(inset(fidcls,vars )) return(uvarptr) ; /* var 型の時 */
- if(inset(fidcls,field)) return(ufldptr) ; /* field型の時 */
- if(inset(fidcls,konst)) return(ucstptr) ; /* const型の時 */
- /* 上記以外=func */ return(ufctptr) ; /* func 型の時 */
- }
-
- /**************************************/
- /* applied() : 引用名チェーン処理 */
- /**************************************/
- void applied(ctp *fcp,int ftoplevel)
- {
- aplist *lap ;
-
- lap = (aplist*)Malloc(sizeof(aplist));
- lap->name = fcp ;
- lap->next = display[ftoplevel].aname ;
- display[ftoplevel].aname = lap ;
- }
-
- /***********************************/
- /* entdtdnames() : 標準名の登録 */
- /***********************************/
- void entstdnames(void)
- {
- ctp *cp;
- ctp *cp1;
- int i;
- char *name;
-
- /**** interger ****/
- cp = mkctp("integer",types,intptr,nil) ;
- enterid(cp);
-
- /**** real ****/
- cp = mkctp("real",types,realptr,nil) ;
- enterid(cp);
-
- /**** char ****/
- cp = mkctp("char",types,charptr,nil) ;
- enterid(cp);
-
- /**** boolean ****/
- cp = mkctp("boolean",types,boolptr,nil) ;
- enterid(cp);
-
- /**** text ****/
- cp = mkctp("text",types,textptr,nil) ;
- enterid(cp) ;
-
- /**** false,true ****/
- cp1 = nil ;
- for(i=0;i<=1;i++) {
- name = (i==0) ? "false" : "true";
- cp = mkctp(name,konst,boolptr,cp1) ;
- cp->n.values.ival = i ; /* false=0; true=1 */
- enterid(cp);
- cp1 = cp ;
- }
- boolptr->sf.sc.fconst = cp ;
-
- /**** maxint ****/
- cp = mkctp("maxint",konst,intptr,nil) ;
- cp->n.values.ival = Maxint ; /* 整数の最大値 */
- enterid(cp) ;
-
- /**** 標準手続き・関数の登録 ****/
- enterstdpf() ;
- }
-
- /**************************************/
- /* entdundecl() : */
- /* 名前が未定義の時の代用名の登録 */
- /**************************************/
- void entundecl(void)
- {
- /**** for types ****/
- utypptr = mkctp(" ",types,nil,nil) ;
-
- /**** for const ****/
- ucstptr = mkctp(" ",konst,nil,nil) ;
- ucstptr->n.values.ival = 0 ;
-
- /**** for vars ****/
- uvarptr = mkctp(" ",vars,nil,nil) ;
- uvarptr->n.v.vkind = actual ;
- uvarptr->n.v.vlev = 0 ;
- uvarptr->n.v.vaddr = 0 ;
-
- /**** for field ****/
- ufldptr = mkctp(" ",field,nil,nil) ;
- ufldptr->n.fldaddr = 0 ;
-
- /**** for procedure ****/
- uprcptr = mkctp(" ",proc,nil,nil) ;
- uprcptr->n.pf.pfdeckind = declared ;
- uprcptr->n.pf.sd.d.pfkind = actual ;
- uprcptr->n.pf.sd.d.pflev = 0 ;
- uprcptr->n.pf.sd.d.af.a.pfname = crelabel() ;
- uprcptr->n.pf.sd.d.af.a.forwdecl = false ;
-
- /**** for function ****/
- ufctptr = mkctp(" ",func,nil,nil) ;
- ufctptr->n.pf.pfdeckind = declared ;
- ufctptr->n.pf.sd.d.pfkind = actual ;
- ufctptr->n.pf.sd.d.pflev = 0 ;
- ufctptr->n.pf.sd.d.af.a.pfname = crelabel() ;
- ufctptr->n.pf.sd.d.af.a.forwdecl = false ;
- }